home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / units / vga256.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-02-02  |  9.7 KB  |  442 lines
  1. UNIT Vga256;
  2.  
  3. INTERFACE
  4.  
  5. CONST     xmax          =319;
  6.           ymax          =199;
  7.  
  8. TYPE      dactype       =ARRAY[0..255,0..2] OF BYTE;
  9.  
  10. VAR       video         :WORD;
  11.           oldx,oldy     :INTEGER;
  12.  
  13.  
  14. {bob-object}
  15. TYPE      bob=OBJECT
  16.             sx,sy,ignore:BYTE; xp,yp :WORD;
  17.             fg,bg :ARRAY[0..31,0..31] OF BYTE;
  18.             PROCEDURE Put;
  19.             PROCEDURE Save;
  20.             PROCEDURE Restore;
  21.           END;
  22.  
  23. {general}
  24. PROCEDURE SetVga256Mode;
  25. PROCEDURE SetTextMode;
  26. PROCEDURE SetPix(Xpix,Ypix:WORD; Color:BYTE);
  27. FUNCTION  GetPix(Xpix,Ypix:WORD):BYTE;
  28. PROCEDURE Clear(Color:BYTE);
  29. PROCEDURE Hline(Xstart,Xstop,Ypos:WORD; Color:BYTE);
  30. PROCEDURE Vline(Xpos,Ystart,Ystop:WORD; Color:BYTE);
  31. PROCEDURE Box(Xa,Ya,Xb,Yb:WORD; Color:BYTE);
  32. PROCEDURE Fbox(Xa,Ya,Xb,Yb:WORD; Color:BYTE);
  33. PROCEDURE Line(xa,ya,xb,yb:INTEGER; color:BYTE);
  34. PROCEDURE LineTo(xb,yb:INTEGER; color:BYTE);
  35.  
  36. {colors}
  37. PROCEDURE SetPal(N,R,G,B:BYTE);
  38. PROCEDURE GetPal(VAR N,R,G,B:BYTE);
  39. PROCEDURE DacLeft(VAR dac:DACTYPE; a,b:BYTE);
  40. PROCEDURE DacRight(VAR dac:DACTYPE; a,b:BYTE);
  41. PROCEDURE SetDacTable(VAR dac);
  42. PROCEDURE GetDacTable(VAR dac);
  43. PROCEDURE FadeOut(dac:DACTYPE; ms:WORD);
  44. PROCEDURE FadeIn(dac:DACTYPE; ms:WORD);
  45.  
  46. IMPLEMENTATION
  47.  
  48. {* general ****************************************************************}
  49.  
  50. PROCEDURE SetVga256Mode; ASSEMBLER;
  51.  ASM
  52.      MOV  video,$A000
  53.      MOV  AX,$0013
  54.      INT  $10
  55.  END;
  56.  
  57. PROCEDURE SetTextMode; ASSEMBLER;
  58.  ASM
  59.      MOV  AX,$0003
  60.      INT  $10
  61.  END;
  62.  
  63. PROCEDURE SetPix(Xpix,Ypix:WORD; Color:BYTE); ASSEMBLER;
  64.  ASM
  65.      CMP  Xpix,xmax
  66.      JA   @Qt
  67.      CMP  Ypix,ymax
  68.      JA   @Qt
  69.      MOV  ES,video
  70.      MOV  AX,320
  71.      MUL  Ypix
  72.      MOV  BX,AX
  73.      ADD  BX,Xpix
  74.      MOV  AL,Color
  75.      MOV  ES:[BX],AL
  76. @Qt:
  77.  END;
  78.  
  79. FUNCTION  GetPix(Xpix,Ypix:WORD):BYTE; ASSEMBLER;
  80.  ASM
  81.      MOV  ES,video
  82.      MOV  AX,320
  83.      MUL  Ypix
  84.      MOV  BX,AX
  85.      ADD  BX,Xpix
  86.      MOV  AL,ES:[BX]
  87.  END;
  88.  
  89. PROCEDURE Clear(Color:BYTE); ASSEMBLER;
  90.  ASM
  91.      MOV  ES,video
  92.      MOV  DI,0
  93.      MOV  CX,32000
  94.      MOV  AH,Color
  95.      MOV  AL,AH
  96.      REP  STOSW
  97.  END;
  98.  
  99. PROCEDURE Hline(Xstart,Xstop,Ypos:WORD; Color:BYTE); ASSEMBLER;
  100.  ASM
  101.      MOV  ES,video              { ES Video Segment }
  102.      MOV  AX,320
  103.      MUL  Ypos
  104.      ADD  AX,Xstart
  105.      MOV  DI,AX                 { DI Start Pixel Video Offset }
  106.      MOV  CX,Xstop
  107.      SUB  CX,Xstart             { CX Count pixels }
  108.      INC  CX
  109.      MOV  AL,Color              { AL Pixel Color }
  110.      REP  STOSB
  111.  END;
  112.  
  113. PROCEDURE Vline(Xpos,Ystart,Ystop:WORD; Color:BYTE); ASSEMBLER;
  114.  ASM
  115.      MOV  ES,video              { ES Video Segment }
  116.      MOV  SI,Xpos
  117.      MOV  AX,320
  118.      MUL  Ystop
  119.      MOV  Ystop,AX
  120.      MOV  AX,320
  121.      MUL  Ystart
  122.      MOV  BX,AX
  123.      MOV  AL,Color
  124. @lp: MOV  ES:[BX+SI],AL
  125.      ADD  BX,320
  126.      CMP  BX,Ystop
  127.      JBE  @lp
  128.  END;
  129.  
  130. PROCEDURE Box(Xa,Ya,Xb,Yb:WORD; Color:BYTE); ASSEMBLER;
  131.  ASM
  132.      MOV  ES,video
  133.      MOV  BX,Xa
  134.      MOV  AX,320
  135.      MUL  Ya
  136.      MOV  SI,AX
  137.      MOV  AX,320
  138.      MUL  Yb
  139.      MOV  DI,AX
  140.      MOV  AL,Color
  141. @lp: MOV  ES:[BX+SI],AL
  142.      MOV  ES:[BX+DI],AL
  143.      INC  BX
  144.      CMP  BX,Xb
  145.      JBE  @lp
  146.      MOV  BX,SI
  147.      MOV  CX,DI
  148.      MOV  SI,Xa
  149.      MOV  DI,Xb
  150. @l2: MOV  ES:[BX+SI],AL
  151.      MOV  ES:[BX+DI],AL
  152.      ADD  BX,320
  153.      CMP  BX,CX
  154.      JBE  @l2
  155.  
  156.  END;
  157.  
  158. PROCEDURE Fbox(Xa,Ya,Xb,Yb:WORD; Color:BYTE); ASSEMBLER;
  159.  ASM
  160.      MOV  ES,video
  161.      MOV  CX,Xb
  162.      SUB  CX,Xa
  163.      INC  CX
  164.      MOV  SI,CX
  165. @lp: MOV  AX,320
  166.      MUL  Ya
  167.      ADD  AX,Xa
  168.      MOV  DI,AX
  169.      MOV  AL,Color
  170.      REP  STOSB
  171.      MOV  CX,SI
  172.      INC  Ya
  173.      MOV  AX,Ya
  174.      CMP  AX,Yb
  175.      JBE  @lp
  176.  END;
  177.  
  178. PROCEDURE Line(xa,ya,xb,yb:INTEGER; color:BYTE); ASSEMBLER;
  179.  VAR d,dx,dy,bi,x,y:INTEGER; {SI=xi} {DI=yi} {CX=ai}
  180.  ASM
  181.      MOV  ES,video
  182.      MOV  AX,xb         { AX=Abs(xb-xa) }
  183.      MOV  oldx,AX
  184.      SUB  AX,xa
  185.      CMP  AX,0
  186.      JGE  @n1
  187.      NEG  AX
  188. @n1: MOV  BX,yb         { BX=Abs(yb-ya) }
  189.      MOV  oldy,BX
  190.      SUB  BX,ya
  191.      CMP  BX,0
  192.      JGE  @n2
  193.      NEG  BX
  194. @n2: CMP  AX,BX         { IF AX<BX THEN continue ELSE jump to @p0 }
  195.      JGE  @p0
  196.      {--------}
  197.      MOV  AX,ya         { IF ya>yb THEN swap parameters }
  198.      CMP  AX,yb
  199.      JLE  @n3
  200.      XCHG AX,yb         { swap parameters }
  201.      XCHG AX,ya
  202.      MOV  AX,xa
  203.      XCHG AX,xb
  204.      XCHG AX,xa  
  205. @n3: MOV  AX,xa         { IF xa<xb THEN Xi=1 ELSE Xi=-1 }
  206.      MOV  si,-1
  207.      CMP  AX,xb
  208.      JGE  @n4
  209.      MOV  si,1
  210. @n4: MOV  AX,yb         { dy=yb-ya }
  211.      SUB  AX,ya
  212.      MOV  dy,AX
  213.      MOV  AX,xb         { dx=Abs(xb-xa) }
  214.      SUB  AX,xa
  215.      CMP  AX,0
  216.      JGE  @n5
  217.      NEG  AX
  218. @n5: MOV  dx,AX
  219.      ADD  AX,AX         { bi=2*dx }
  220.      MOV  bi,AX
  221.      SUB  AX,dy         { d=2*dx-dy }
  222.      MOV  d,AX
  223.      MOV  AX,dx         { ai:=2*(dx-dy) }
  224.      SUB  AX,dy
  225.      ADD  AX,AX
  226.      MOV  cx,AX
  227.      MOV  AX,xa         { x=xa }
  228.      MOV  x,AX
  229.      MOV  AX,ya         { y=ya }
  230.      MOV  y,AX
  231. @px: CMP  x,xmax        { SetPix(x,y,color) }
  232.      JA   @n6
  233.      CMP  y,ymax
  234.      JA   @n6
  235.      MOV  AX,320
  236.      MUL  y
  237.      MOV  BX,AX
  238.      ADD  BX,x
  239.      MOV  AL,color
  240.      MOV  ES:[BX],AL
  241. @n6: INC  y             { y=y+1 (next pixel) }
  242.      CMP  d,0           { IF (D>=0) THEN continue ELSE jump to @n7 }
  243.      JL   @n7
  244.      ADD  x,si          { Inc(x,xi) }
  245.      ADD  d,cx          { Inc(d,ai) }
  246.      JMP  @n8
  247. @n7: MOV  AX,bi         { Inc(d,bi) }
  248.      ADD  d,AX
  249. @n8: MOV  AX,y          { IF y<=yb THEN draw next pixel }
  250.      CMP  AX,yb
  251.      JLE  @px
  252.      JMP  @Qt
  253.      {--------}
  254. @p0: MOV  AX,xa         { IF xa>xb THEN swap parameters }
  255.      CMP  AX,xb
  256.      JLE  @p3
  257.      XCHG AX,xb         { swap parameters }
  258.      XCHG AX,xa
  259.      MOV  AX,ya
  260.      XCHG AX,yb
  261.      XCHG AX,ya
  262. @p3: MOV  AX,ya         { IF ya<yb THEN Yi=1 ELSE Yi=-1 }
  263.      MOV  di,-1
  264.      CMP  AX,yb
  265.      JGE  @p4
  266.      MOV  di,1
  267. @p4: MOV  AX,xb         { dx=xb-xa }
  268.      SUB  AX,xa
  269.      MOV  dx,AX
  270.      MOV  AX,yb         { dy=Abs(yb-ya) }
  271.      SUB  AX,ya
  272.      CMP  AX,0
  273.      JGE  @p5
  274.      NEG  AX
  275. @p5: MOV  dy,AX
  276.      ADD  AX,AX         { bi=2*dy }
  277.      MOV  bi,AX
  278.      SUB  AX,dx         { d=(2*dy)-dx }
  279.      MOV  d,AX
  280.      MOV  AX,dy         { ai=2*(dy-dx) }
  281.      SUB  AX,dx
  282.      ADD  AX,AX
  283.      MOV  cx,AX
  284.      MOV  AX,xa         { x=xa }
  285.      MOV  x,AX
  286.      MOV  AX,ya         { y=ya }
  287.      MOV  y,AX
  288. @py: CMP  x,xmax        { SetPix(x,y,color) }
  289.      JA   @n6
  290.      CMP  y,ymax
  291.      JA   @p6
  292.      MOV  AX,320
  293.      MUL  y
  294.      MOV  BX,AX
  295.      ADD  BX,x
  296.      MOV  AL,color
  297.      MOV  ES:[BX],AL
  298. @p6: INC  x             { x=x+1 (next pixel) }
  299.      CMP  d,0           { IF D>=0 THEN continue ELSE jump to @p7 }
  300.      JL   @p7
  301.      ADD  y,di          { Inc(y,yi) }
  302.      ADD  d,cx          { Inc(d,ai) }
  303.      JMP  @p8
  304. @p7: MOV  AX,bi         { Inc(d,bi) }
  305.      ADD  d,AX
  306. @p8: MOV  AX,x          { IF x<=xb THEN draw next pixel }
  307.      CMP  AX,xb
  308.      JLE  @py
  309. @Qt:
  310.  END;
  311.  
  312. PROCEDURE LineTo(xb,yb:INTEGER; color:BYTE);
  313.  BEGIN
  314.    Line(oldx,oldy,xb,yb,color);
  315.  END;
  316.  
  317. {* colors *****************************************************************}
  318.  
  319. PROCEDURE SetPal(N,R,G,B:BYTE);
  320.  BEGIN
  321.    Port[$3C8]:=N;
  322.    Port[$3C9]:=R;
  323.    Port[$3C9]:=B;
  324.    Port[$3C9]:=G;
  325.  END;
  326.  
  327. PROCEDURE GetPal(VAR N,R,G,B:BYTE);
  328.  BEGIN
  329.    Port[$3C7]:=N;
  330.    R:=Port[$3C9];
  331.    G:=Port[$3C9];
  332.    B:=Port[$3C9];
  333.  END;
  334.  
  335. PROCEDURE SetDacTable(VAR dac); ASSEMBLER;
  336.  ASM
  337.      PUSH DS
  338.      LDS  SI,dac
  339.      MOV  DX,$3C8
  340.      MOV  AL,0
  341.      MOV  CX,768
  342.      OUT  DX,AL
  343.      INC  DX
  344.      REP  OUTSB
  345.      POP  DS
  346.  END;
  347.  
  348. PROCEDURE GetDacTable(VAR dac); ASSEMBLER;
  349.  ASM
  350.      LES  DX,dac
  351.      MOV  AX,$1017
  352.      MOV  BX,$0000
  353.      MOV  CX,$0100
  354.      INT  $10
  355.  END;
  356.  
  357. PROCEDURE DacLeft(VAR dac:DACTYPE; a,b:BYTE);
  358.  VAR t,u:BYTE; v:ARRAY[0..2] OF BYTE;
  359.  BEGIN
  360.    v[0]:=dac[a,0]; v[1]:=dac[a,1]; v[2]:=dac[a,2];
  361.    FOR t:=a+1 TO b DO FOR u:=0 TO 2 DO dac[t-1,u]:=dac[t,u];
  362.    dac[b,0]:=v[0]; dac[b,1]:=v[1]; dac[b,2]:=v[2];
  363.  END;
  364.  
  365. PROCEDURE DacRight(VAR dac:DACTYPE; a,b:BYTE);
  366.  VAR t,u:BYTE; v:ARRAY[0..2] OF BYTE;
  367.  BEGIN
  368.    v[0]:=dac[b,0]; v[1]:=dac[b,1]; v[2]:=dac[b,2];
  369.  
  370.    FOR t:=b DOWNTO a+1 DO FOR u:=0 TO 2 DO dac[t,u]:=dac[t-1,u];
  371.  
  372.    dac[a,0]:=v[0]; dac[a,1]:=v[1]; dac[a,2]:=v[2];
  373.  END;
  374.  
  375. PROCEDURE FadeOut(dac:DACTYPE; ms:WORD); 
  376.  VAR finished:BOOLEAN; t,u:BYTE;
  377.  BEGIN
  378.    REPEAT
  379.      finished:=TRUE;
  380.      FOR t:=0 TO 255 DO FOR u:=0 TO 2 DO IF dac[t,u]>0 THEN
  381.       BEGIN
  382.         finished:=FALSE;
  383.         Dec(dac[t,u]);
  384.       END;
  385.      SetDacTable(dac);
  386.       ASM
  387.        MOV AX,1000
  388.        MUL ms
  389.        MOV CX,DX
  390.        MOV DX,AX
  391.        MOV AH,$86
  392.        INT $15
  393.       END;
  394.    UNTIL finished;
  395.  END;
  396.  
  397. PROCEDURE FadeIn(dac:DACTYPE; ms:WORD);
  398.  VAR t,u:BYTE; finished:BOOLEAN; tmp:DACTYPE;
  399.  BEGIN
  400.    FOR t:=0 TO 255 DO FOR u:=0 TO 2 DO tmp[t,u]:=0;
  401.    REPEAT
  402.      finished:=TRUE;
  403.      FOR t:=0 TO 255 DO FOR u:=0 TO 2 DO IF dac[t,u]>tmp[t,u] THEN
  404.       BEGIN
  405.         finished:=FALSE;
  406.         Inc(tmp[t,u]);
  407.       END;
  408.      SetDacTable(tmp);
  409.       ASM
  410.        MOV AX,1000
  411.        MUL ms
  412.        MOV CX,DX
  413.        MOV DX,AX
  414.        MOV AH,$86
  415.        INT $15
  416.       END;
  417.    UNTIL finished;
  418.  END;
  419.  
  420. {* bob-object *************************************************************}
  421.  
  422. PROCEDURE bob.Put;
  423.  VAR tx,ty:BYTE;
  424.  BEGIN
  425.    FOR tx:=0 to sx DO for ty:=0 TO sy DO
  426.    IF fg[tx,ty]<>ignore THEN SetPix(xp+tx,yp+ty,fg[tx,ty]);
  427.  END;
  428.  
  429. PROCEDURE bob.Save;
  430.  VAR tx,ty:BYTE;
  431.  BEGIN
  432.    FOR tx:=0 to sx DO for ty:=0 TO sy DO bg[tx,ty]:=GetPix(xp+tx,yp+ty);
  433.  END;
  434.  
  435. PROCEDURE bob.Restore;
  436.  VAR tx,ty:BYTE;
  437.  BEGIN
  438.    FOR tx:=0 to sx DO for ty:=0 TO sy DO SetPix(xp+tx,yp+ty,bg[tx,ty]);
  439.  END;
  440.  
  441. BEGIN
  442. END.